home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / callbutn / btrv.bas next >
Encoding:
BASIC Source File  |  1995-10-23  |  8.1 KB  |  163 lines
  1.     
  2.  
  3. '   ============================
  4. '   Interface from VB to Btrieve
  5. '   ============================
  6. Sub CallBtrv (ByVal OpCod As Integer, ByVal FileNo As Integer, ByVal KeyNo As Integer)
  7.     Dim LockType As Integer                     ' record lock type
  8.     Static DupFlg As Integer                    ' duplicates flag
  9.     Dim NoData As Integer                       ' key only flag (bias of 50)
  10.     Dim KVal As String                          ' key value sent to Btrieve
  11.     LockType = (OpCod \ 100) * 100              ' extract lock type
  12.     OpCod = OpCod - LockType                    ' adjust to actual op code
  13.     NoData = 0                                  ' assume we want data in GET operations
  14.     If OpCod > 54 And OpCode < 74 Then          ' do we want just the key in GET operations?
  15.         NoData = 50                             ' yes
  16.         OpCod = OpCode - NoData                 ' adjust to actual op code
  17.     End If
  18.     If OpCod < 0 Or OpCod > 49 Then             ' is this a valid op code?
  19.         BStatus = BE_INVALID_OPCOD
  20.         GoTo Fatal
  21.     End If
  22.     Select Case OpCod
  23.         Case 0 ' Open a file
  24.             KVal = Path + FileName(FileNo)          ' put the filename in the key buffer
  25.             GoSub MakeCall                          ' do it
  26.             If BStatus = BE_FILENOTFOUND Then       ' file not found?
  27.                 Exit Sub
  28.             ElseIf BStatus = BE_FILE_LOCKED Then    ' is file locked?
  29.                 Beep
  30.                 MsgBox "File" + Str$(FileNo) + " is locked by another user. Try again later!", 16, "File open error"
  31.             ElseIf BStatus = BE_PERMISSION Then     ' network permission error?
  32.                 Beep
  33.                 MsgBox "Permission error", 16, "File open error"
  34.             ElseIf BStatus <> BE_OK Then            ' any other error
  35.                 GoTo Fatal
  36.             End If
  37.         Case 1 ' Close a file
  38.             GoSub MakeCall                          ' do it
  39.             If BStatus <> BE_OK Then                ' error closing the file?
  40.                 GoTo Fatal
  41.             End If
  42.         Case 2 ' Insert
  43.             KVal = Space$(128)                      ' create key buffer
  44.             GoSub LoadBuf                           ' put the data into Btrieve's buffer
  45.             GoSub MakeCall                          ' do it
  46.                                                     ' check for errors
  47.             If BStatus <> BE_OK And BStatus <> BE_CONFLICT And BStatus <> BE_READ_OUT_TRANS And BStatus <> BE_RECORD_LOCKED Then
  48.                 GoTo Fatal
  49.             End If
  50.             KeyVal = Left$(KVal, KeyLen(FileNo, KeyNo)) ' return the key
  51.         Case 3 ' Update
  52.             KVal = KeyVal + Space$(128 - Len(KeyVal))   ' create the key buffer
  53.             GoSub LoadBuf                           ' put the data into Btrieve's buffer
  54.             GoSub MakeCall                          ' do it
  55.                                                     ' check for errors
  56.             If BStatus <> BE_OK And BStatus <> BE_CONFLICT And BStatus <> BE_READ_OUT_TRANS And BStatus <> BE_RECORD_LOCKED Then
  57.                 GoTo Fatal
  58.             End If
  59.             KeyVal = Left$(KVal, KeyLen(FileNo, KeyNo)) ' return the key
  60.         Case 4 ' Delete
  61.             GoSub MakeCall                          ' do it
  62.                                                     ' check for errors
  63.             If BStatus <> BE_OK And BStatus <> BE_CONFLICT And BStatus <> BE_READ_OUT_TRANS And BStatus <> BE_RECORD_LOCKED Then
  64.                 GoTo Fatal
  65.             End If
  66.         Case 5 To 13 ' GET operations
  67.             KVal = KeyVal + Space$(128 - Len(KeyVal))   ' create the key buffer
  68.             GoSub MakeCall                              ' do it
  69.             If BStatus = BE_EOF Then                    ' end of file?
  70.                 KeyVal = ""
  71.                                                         ' check for other errors?
  72.             ElseIf BStatus <> BE_OK And BStatus <> BE_KEYNOTFOUND And BStatus <> BE_RECORD_LOCKED Then
  73.                 GoTo Fatal
  74.             End If
  75.             If Not NoData Then                          ' if we want the data
  76.                 GoSub ExtractBuf                        ' put it in the file's data buffer
  77.             End If
  78.             If BStatus = BE_OK Then                     ' if operations successfil
  79.                 KeyVal = Left$(KVal, KeyLen(FileNo, KeyNo)) ' return the key value
  80.             End If
  81.         Case 14 ' Create
  82.             KVal = Path + FileName(FileNo)              ' put the filename into the key buffer
  83.             GoSub MakeCall                              ' do it
  84.         Case 19 To 21 ' Begin, End and Abort Transaction
  85.             GoSub MakeCall                              ' just do it
  86.         Case 22 ' Get position
  87.             GoSub MakeCall                              ' do it
  88.                                                         ' return the position in the key value
  89.             KeyVal = Left$(BtrvBuf.buffer, KeyLen(FileNo, KeyNo))
  90.         Case 23 ' Get direct
  91.             BtrvBuf.buffer = KeyVal                     ' put the position in Btrieve's data buffer
  92.             KVal = Space$(128)                          ' create a key buffer
  93.             GoSub MakeCall                              ' do it
  94.             If BStatus = BE_OK Then                     ' if successful
  95.                 GoSub ExtractBuf                        ' put the data into the file's data buffer
  96.             End If
  97.             KeyVal = Left$(KVal, KeyLen(FileNo, KeyNo)) ' extract the key value
  98.         Case 24, 33 To 35 ' Step direct, step first, last, previous
  99.             GoSub MakeCall                              ' do it
  100.             If BStatus = BE_OK Then                     ' if successful
  101.                 GoSub ExtractBuf                        ' put the data into the file's data buffer
  102.             End If
  103.         Case 25 ' Stop Btrieve
  104.             GoSub MakeCall                              ' do it
  105.         Case 27 ' Unlock
  106.             If KeyNo = 1 Then                           ' unlock a multiple record lock?
  107.                 BtrvBuf.buffer = KeyVal                 ' put the position into the data buffer
  108.             End If
  109.             GoSub MakeCall                              ' do it
  110.         Case 28 ' Reset
  111.             GoSub MakeCall
  112.             KeyVal = ""                                 ' return null
  113.         Case 48 ' No of Recs
  114.             OpCod = 15                                  ' set op code for Btrieve's use
  115.             GoSub fStat                                 ' do a Btrieve status
  116.             KeyVal = Str$(cvl(Mid$(BtrvBuf.buffer, 7, 4)))  ' return the number of records as a string in KeyVal
  117.         Case 49 ' Toggle DupFlg
  118.             DupFlg = Not (DupFlg)                       ' toggle duplicates flag
  119.     End Select
  120.     Exit Sub
  121.  
  122. MakeCall:
  123.     ' call Btrieve
  124.     BStatus = BtrCall(OpCod + NoData + LockType, PosBlk(FileNo), BtrvBuf, Len(BtrvBuf), KVal, Len(KVal), KeyNo)
  125.     Return
  126. ExtractBuf:
  127.     ' put Btrieve's data buffer into the files data buffer
  128.     ' modify this section for your files
  129.     Select Case FileNo
  130.         Case 0
  131.             LSet ChartRec = BtrvBuf
  132.         End Select
  133.     Return
  134. LoadBuf:
  135.     ' put the file's data buffer into Btrieve's data buffer
  136.     ' modify this section for your files
  137.     Select Case FileNo
  138.         Case 0
  139.             LSet BtrvBuf = ChartRec
  140.         End Select
  141.     Return
  142. fStat:  ' status op code
  143.     KVal = Space$(128)
  144.     GoSub MakeCall
  145.     Return
  146. Fatal:  ' process any errors
  147.     If BStatus = BE_DUPKEY And DupFlg Then  ' duplicates ok?
  148.         Return                              ' continue
  149.     End If
  150.     ' show error
  151.     Beep
  152.     MsgBox "Btrieve error" + Str$(BStatus) + " for file " + FileName(FileNo), 16, "Btrieve error"
  153. End Sub
  154.  
  155. '   This function takes a 4 byte string representation of
  156. '   a 4 byte long integer and creates the integer
  157. '   This function is included is other Basics but was
  158. '   omitted in VB
  159. Function cvl (mkl As String) As Long
  160.     cvl = Asc(Left$(mkl, 1)) + Asc(Mid$(mkl, 2, 1)) And 255 + (Asc(Mid$(mkl, 3, 1)) + (Asc(Right$(mkl, 1)) And 255) And 65535)
  161. End Function
  162.  
  163.